home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / TOOLPAS2 / DISPEDIT.PAS < prev    next >
Pascal/Delphi Source File  |  1992-09-01  |  29KB  |  1,013 lines
  1.  
  2. (*
  3.  * Copyright 1987, 1989 Samuel H. Smith;  All rights reserved
  4.  *
  5.  * This is a component of the ProDoor System.
  6.  * Do not distribute modified versions without my permission.
  7.  * Do not remove or alter this notice or any other copyright notice.
  8.  * If you use this in your own program you must distribute source code.
  9.  * Do not use any of this in a commercial product.
  10.  *
  11.  *)
  12.  
  13. (*
  14.  * dispedit - display/edit support functions for interactive
  15.  *            configuration type programs. (3-1-89)
  16.  *
  17.  *)
  18.  
  19. {$i prodef.inc}
  20.  
  21. unit dispedit;
  22.  
  23. {$v-}
  24.  
  25. interface
  26.    uses dos, crt, tools;
  27.  
  28.    const
  29.       prompt_attr:   word = (BLACK*16)    + WHITE;
  30.       input_attr:    word = (LIGHTRED*16) + WHITE;
  31.       data_attr:     word = (BLACK*16)    + WHITE;
  32.  
  33.    type
  34.       charset        = string[128];
  35.  
  36.       edit_functions = (display, edit, clear);
  37.  
  38.       border_styles  = (blank_border,          single_border,
  39.                         double_border,         mixed_border,
  40.                         taildouble_border,
  41.                         solid_border,          evensolid_border,
  42.                         thinsolid_border,      lohatch_border,
  43.                         medhatch_border,       hihatch_border);
  44.  
  45.       display_image_type = array[1..2000] of record
  46.          chr:  char;
  47.          attr: byte;
  48.       end;
  49.  
  50.       display_image_rec = record
  51.          crt:  display_image_type;
  52.          mode: word;
  53.          attr: byte;
  54.          wmin: word;
  55.          wmax: word;
  56.          x,y:  byte;
  57.       end;
  58.  
  59.    var
  60.       disp_mem:   ^display_image_type;
  61.  
  62.       lastData:   ^char;      {pointer to last variable edited}
  63.       lastSize:   integer;    {size of last variable edited}
  64.  
  65.    const
  66.       allchars:   charset = ' !"#$%&''()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`abcdefghijklmnopqrstuvwxyz{|}~';
  67.       namechars:  charset = '!#$%&''()+-.0123456789:@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_{}~';
  68.  
  69.       YES         = 'Y';      NO          = 'N';
  70.       BACKSPACE   = #8;       TAB         = #9;
  71.       ENTERKEY    = #13;      ESC         = #27;
  72.       F1          = #201;     F2          = #202;
  73.       F3          = #203;     F4          = #204;
  74.       F5          = #205;     F6          = #206;
  75.       F7          = #207;     F8          = #208;
  76.       F9          = #209;     F10         = #210;
  77.       HOME        = #213;     UP          = #214;
  78.       PGUP        = #215;     LEFT        = #217;
  79.       RIGHT       = #219;     ENDK        = #221;
  80.       DOWN        = #222;     PGDN        = #223;
  81.       INS         = #224;     DEL         = #225;
  82.       CTRL_F1     = #236;     CTRL_F2     = #237;
  83.       CTRL_F3     = #238;     CTRL_F9     = #244;
  84.       CTRL_F10    = #245;     CTRL_PGUP   = #18;
  85.       CTRL_PGDN   = #4;       CTRL_LEFT   = #1;
  86.       CTRL_RIGHT  = #2;       CTRL_HOME   = #5;
  87.       CTRL_END    = #3;       SHIFT_TAB   = #157;
  88.       ALT_D       = #174;     ALT_I       = #165;
  89.  
  90.       data_changed: boolean = false;
  91.  
  92.       py: integer = -1;
  93.       px: integer = -1;
  94.  
  95.       traceopen: boolean = false;
  96.  
  97.    var
  98.       tracefd: text;
  99.  
  100.  
  101.    procedure disp(s: string);
  102.    procedure displn(s: string);
  103.    procedure dispc(c: char);
  104.    procedure newline;
  105.  
  106.    function make_string(ch: char; size: byte): string;
  107.  
  108.    procedure display_border(topx,topy,
  109.                             botx,boty: integer;
  110.                             style:     border_styles);
  111.  
  112.    procedure beep;
  113.  
  114.    function get_key: char;
  115.  
  116.    procedure edit_string ( func:      edit_functions;
  117.                            x,y:       integer;
  118.                            prompt:    string;
  119.                            var data:  string;
  120.                            width:     integer;
  121.                            var term:  char );
  122.  
  123.    procedure edit_fname ( func:      edit_functions;
  124.                           x,y:       integer;
  125.                           prompt:    string;
  126.                           var data:  string;
  127.                           width:     integer;
  128.                           isdir:     boolean;
  129.                           var term:  char );
  130.  
  131.    procedure edit_chars  ( func:      edit_functions;
  132.                            x,y:       integer;
  133.                            prompt:    string;
  134.                            var data;
  135.                            width:     integer;
  136.                            var term:  char );
  137.  
  138.    procedure edit_longint( func:     edit_functions;
  139.                            x,y:      integer;
  140.                            prompt:   string;
  141.                            var data: longint;
  142.                            width:    integer;
  143.                            min,max:  longint;
  144.                            var term: char );
  145.  
  146.    procedure edit_integer( func:     edit_functions;
  147.                            x,y:      integer;
  148.                            prompt:   string;
  149.                            var data: integer;
  150.                            width:    integer;
  151.                            min,max:  integer;
  152.                            var term: char );
  153.  
  154.    procedure edit_byte   ( func:     edit_functions;
  155.                            x,y:      integer;
  156.                            prompt:   string;
  157.                            var data: byte;
  158.                            width:    integer;
  159.                            min,max:  byte;
  160.                            var term: char );
  161.  
  162.    procedure edit_word   ( func:     edit_functions;
  163.                            x,y:      integer;
  164.                            prompt:   string;
  165.                            var data: word;
  166.                            width:    integer;
  167.                            min,max:  word;
  168.                            var term: char );
  169.  
  170.    procedure edit_real   ( func:     edit_functions;
  171.                            x,y:      integer;
  172.                            prompt:   string;
  173.                            var data: real;
  174.                            width:    integer;
  175.                            deci:     integer;
  176.                            var term: char );
  177.  
  178.    procedure edit_yesno(   func:      edit_functions;
  179.                            x,y:       integer;
  180.                            prompt:    string;
  181.                            var data:  boolean;
  182.                            var term:  char );
  183.  
  184.    procedure edit_funkey( func:      edit_functions;
  185.                           x,y:       integer;
  186.                           prompt:    string;
  187.                           key:       char;
  188.                           var term:  char );
  189.  
  190.    procedure select_next_entry( func:    edit_functions;
  191.                                 var en:  integer;
  192.                                 maxen:   integer;
  193.                                 var key: char);
  194.  
  195.    procedure clear_screen;
  196.  
  197.    procedure vscroll_bar(current, min, max: word;
  198.                          x,y1,y2: byte);
  199.  
  200.    procedure hscroll_bar(current, min, max: word;
  201.                          y,x1,x2: byte);
  202.  
  203.    procedure opentrace(name: string);
  204.    procedure closetrace;
  205.  
  206.    procedure input(var line:  string;
  207.                    maxlen:    integer);
  208.  
  209.    procedure save_display(var disp: display_image_rec);
  210.    procedure restore_display(var disp: display_image_rec);
  211.    procedure shadow_display;
  212.  
  213.  
  214. implementation
  215.  
  216.  
  217.    (* -------------------------------------------------- *)
  218.    procedure disp(s: string);
  219.    begin
  220.       write(s);
  221.       if traceopen then
  222.          write(tracefd,s);
  223.    end;
  224.  
  225.    procedure newline;
  226.    begin
  227.       disp(^M^J);
  228.    end;
  229.  
  230.    procedure displn(s: string);
  231.    begin
  232.       disp(s);
  233.       newline;
  234.    end;
  235.  
  236.    procedure dispc(c: char);
  237.    begin
  238.       disp(c);
  239.    end;
  240.  
  241.  
  242.    (* -------------------------------------------------- *)
  243.    function make_string(ch: char; size: byte): string;
  244.    var
  245.       st: string;
  246.    begin
  247.       fillchar(st[1],size,ch);
  248.       st[0] := chr(size);
  249.       make_string := st;
  250.    end;
  251.  
  252.  
  253.    (* -------------------------------------------------- *)
  254.    procedure display_border(topx,topy,
  255.                             botx,boty: integer;
  256.                             style:     border_styles);
  257.       (* display a window border.  enter with desired color settingx*)
  258.    var
  259.       left:        string[80];
  260.       right:       string[80];
  261.       top:         string[80];
  262.       bottom:      string[80];
  263.       width:       integer;
  264.       b:           string[8];
  265.       i,j:         integer;
  266.  
  267.    const
  268.      border_table:  array[blank_border..hihatch_border] of string[8] =
  269.        ('        ',  { blank     }         '┌─┐││└─┘',  { single    }
  270.         '╔═╗║║╚═╝',  { double    }         '╒═╕││╘═╛',  { mixed     }
  271.         '╠═╗║║╚═╝',  { taildouble}
  272.         '████████',  { solid     }         '█▀████▄█',  { evensolid }
  273.         '▐▀▌▐▌▐▄▌',  { thinsolid }         '░░░░░░░░',  { lohatch   }
  274.         '▒▒▒▒▒▒▒▒',  { medhatch  }         '▓▓▓▓▓▓▓▓'); { hihatch   }
  275.  
  276.       topleft  = 1;    {border character locations in border strings}
  277.       tophor   = 2;
  278.       topright = 3;
  279.       leftver  = 4;
  280.       rightver = 5;
  281.       botleft  = 6;
  282.       bothor   = 7;
  283.       botright = 8;
  284.  
  285.       filler = ^@^H^J^@^H^J^@^H^J^@^H^J^@^H^J^@^H^J^@^H^J^@^H^J^@^H^J^@^H^J^@^H^J^@^H^J^@^H^J;
  286.  
  287.    begin
  288.       b := border_table[style];
  289.       width := botx - topx - 2;
  290.  
  291.    (* top and bottom of frame *)
  292.       bottom[0]    := chr(width+2);
  293.       top[0]       := chr(width+2);
  294.       top[1]       := b[topleft];
  295.       for i := 2 to width+1 do
  296.          top[i] := b[tophor];
  297.       top[width+2] := b[topright];
  298.  
  299.       bottom[0]       := chr(width+2);
  300.       bottom[1]       := b[botleft];
  301.       for i := 2 to width+1 do
  302.          bottom[i] := b[bothor];
  303.       bottom[width+2] := b[botright];
  304.  
  305.  
  306.    (* sides of frame *)
  307.       left := filler + filler;
  308.       right := left;
  309.       j := 1;
  310.       for i := 2 to boty - topy do
  311.       begin
  312.          left[j]:= b[leftver];
  313.          right[j]:= b[rightver];
  314.          j := j + 3;
  315.       end;
  316.       left[0]:= chr (j - 1);
  317.       right[0]:= left[0];
  318.  
  319.    (* draw the frame *)
  320.       gotoxy(topx,topy);     disp(top);
  321.       gotoxy(topx,topy+1);   disp(left);
  322.       gotoxy(botx-1,topy+1); disp(right);
  323.       gotoxy(topx,boty);     disp(bottom);
  324.    end;
  325.  
  326.  
  327.    (* -------------------------------------------------- *)
  328.    procedure beep;
  329.    begin
  330.       disp(^G);
  331.    end;
  332.  
  333.  
  334.    (* -------------------------------------------------- *)
  335.    function get_key: char;
  336.    var
  337.       c: char;
  338.    begin
  339.       c := readkey;
  340.       if c = #0 then
  341.          c := chr(ord(readkey) + 142);
  342.       get_key := c;
  343.    end;
  344.  
  345.  
  346.    (* -------------------------------------------------- *)
  347.    procedure raw_editor( func:       edit_functions;
  348.                          x,y:        integer;
  349.                          prompt:     string;
  350.                          var data:   string;
  351.                          width:      integer;
  352.                          var term:   char;
  353.                          upper:      boolean;
  354.                          legal:      charset );
  355.    var
  356.       col:        integer;
  357.       ch:         char;
  358.       filler:     string;
  359.       fillch:     char;
  360.       insmode:    boolean;
  361.  
  362.    begin
  363.       if length(data) > width then
  364.          data[0] := chr(width);
  365.       if upper then
  366.          stoupper(data);
  367.  
  368.       case func of
  369.          display:
  370.             fillch := '_';
  371.          edit:
  372.             fillch := '░';
  373.          clear:
  374.             begin
  375.                fillch := ' ';
  376.                data := '';
  377.             end;
  378.       end;
  379.  
  380.       filler := make_string( fillch, width - length(data) ) + ' ';
  381.  
  382.       lowvideo;
  383.       gotoxy( x, y );
  384.       textbackground(prompt_attr shr 4);
  385.       textcolor(prompt_attr and 15);
  386.       disp( prompt );
  387.  
  388.       if func <> edit then
  389.       begin
  390.          textbackground(data_attr shr 4);
  391.          textcolor(data_attr and 15);
  392.          disp( copy( data, 1, width ) );
  393.          lowvideo;
  394.          disp( filler );
  395.          highvideo;
  396.          exit;
  397.       end;
  398.  
  399.       textbackground(input_attr shr 4);
  400.       textcolor(input_attr and 15);
  401.       disp( copy( data, 1, width ) );
  402.       lowvideo;
  403.       disp( filler );
  404.  
  405.   (* default to overtype mode *)
  406.       textbackground(input_attr shr 4);
  407.       textcolor(input_attr and 15);
  408.       insmode := false;
  409.       gotoxy(74,23);
  410.       disp('OVR');
  411.  
  412.    (* record location of last edited data *)
  413.       lastData := @data;
  414.       lastSize := width+1;
  415.  
  416.    (* general edit string function *)
  417.       inc(x,length(prompt));
  418.       col := 0;
  419.       term := '0';
  420.  
  421.       repeat
  422.          gotoxy( x + col, y );
  423.          ch := get_key;
  424.  
  425.          case ch of
  426.             HOME: col := 0;
  427.  
  428.             ENDK: col := length(data);
  429.  
  430.             LEFT: if col > 0 then
  431.                      dec(col)
  432.                   else
  433.                      term := UP;
  434.  
  435.             RIGHT:
  436.                   if col < length(data) then
  437.                      inc(col)
  438.                   else
  439.                      term := DOWN;
  440.  
  441.             DEL:  if col < length( data ) then
  442.                   begin
  443.                      delete( data, col + 1, 1 );
  444.                      disp( copy( data, col + 1, width )+ fillch );
  445.                      data_changed := true;
  446.                   end;
  447.  
  448.             INS:  begin
  449.                      insmode := not insmode;
  450.                      gotoxy(74,23);
  451.                      if insmode then
  452.                         disp('INS')
  453.                      else
  454.                         disp('OVR');
  455.                   end;
  456.  
  457.             BACKSPACE:
  458.                   if col > 0 then
  459.                   begin
  460.                      delete( data, col, 1 );
  461.                      disp( ^h + copy( data, col, width )+ fillch );
  462.                      dec(col);
  463.                      data_changed := true;
  464.                   end
  465.                   else
  466.                      beep;
  467.  
  468.             F1..F10, ESC,
  469.             ALT_D, ALT_I,
  470.             ENTERKEY, UP, DOWN,
  471.             PGUP, PGDN,
  472.             CTRL_PGUP, CTRL_PGDN,
  473.             CTRL_HOME, CTRL_END:
  474.                   term := ch;
  475.  
  476.             else  begin
  477.                      if upper then
  478.                         ch := upcase(ch);
  479.  
  480.                      if pos(ch,legal) > 0 then
  481.                      begin
  482.                         if insmode and
  483.                            (length( data) >= col) and
  484.                            (length( data ) < width) then
  485.                         begin
  486.                            if length(data) < width then
  487.                            begin
  488.                               insert( ' ',data, col+1 );
  489.                               disp( copy( data, col+1, width ) );
  490.                            end;
  491.                            data_changed := true;
  492.                            gotoxy( x + col, y );
  493.                         end;
  494.  
  495.                         if col < width then
  496.                         begin
  497.                            inc(col);
  498.                            if col > length( data ) then
  499.                               data := data + ch
  500.                            else
  501.                               data[ col ] := ch;
  502.  
  503.                            disp( ch );
  504.                            data_changed := true;
  505.                         end
  506.                         else
  507.                            beep;
  508.                      end
  509.                      else
  510.  
  511.                      begin
  512.                         gotoxy(1,1);
  513.                         write('ch=',ord(ch):3);
  514.                         beep;
  515.                      end;
  516.                   end;
  517.          end;
  518.  
  519.       until term <> '0';
  520.  
  521.       gotoxy( x, y );
  522.       textbackground(data_attr shr 4);
  523.       textcolor(data_attr and 15);
  524.       disp( data );
  525.       lowvideo;
  526.       disp( make_string( '_', width-length(data) )+' ' );
  527.    end;
  528.  
  529.  
  530.    (* -------------------------------------------------- *)
  531.    procedure edit_string( func:      edit_functions;
  532.                           x,y:       integer;
  533.                           prompt:    string;
  534.                           var data:  string;
  535.                           width:     integer;
  536.                           var term:  char );
  537.    begin
  538.       raw_editor( func, x, y, prompt, data, width, term, false, allchars);
  539.    end;
  540.  
  541.  
  542.    (* -------------------------------------------------- *)
  543.    procedure edit_fname ( func:      edit_functions;
  544.                           x,y:       integer;
  545.                           prompt:    string;
  546.                           var data:  string;
  547.                           width:     integer;
  548.                           isdir:     boolean;
  549.                           var term:  char );
  550.    begin
  551.       raw_editor( func, x, y, prompt, data, width, term, true, namechars);
  552.  
  553.       if isdir and (data[length(data)] <> '\') and (length(data) > 1) then
  554.       begin
  555.          inc(data[0]);
  556.          data[length(data)] := '\';
  557.       end;
  558.    end;
  559.  
  560.  
  561.    (* -------------------------------------------------- *)
  562.    procedure edit_chars( func:      edit_functions;
  563.                          x,y:       integer;
  564.                          prompt:    string;
  565.                          var data;
  566.                          width:     integer;
  567.                          var term:  char );
  568.    var
  569.       cdata:   array[1..255] of char absolute data;
  570.       sdata:   string;
  571.       i:       integer;
  572.  
  573.    begin
  574.       for i := 1 to width do
  575.          sdata[i] := cdata[i];
  576.       sdata[0] := chr(width);
  577.       while sdata[length(sdata)] = ' ' do
  578.          dec(sdata[0]);
  579.  
  580.       raw_editor( func, x, y, prompt, sdata, width, term, false, allchars);
  581.  
  582.       sdata := ljust(sdata,width);
  583.       for i := 1 to width do
  584.          cdata[i] := sdata[i];
  585.    end;
  586.  
  587.  
  588.    (* -------------------------------------------------- *)
  589.    procedure edit_longint( func:     edit_functions;
  590.                            x,y:      integer;
  591.                            prompt:   string;
  592.                            var data: longint;
  593.                            width:    integer;
  594.                            min,max:  longint;
  595.                            var term: char );
  596.    var
  597.       temp:       string;
  598.       code:       integer;
  599.       new_data:   longint;
  600.       keys:       string[11];
  601.  
  602.    begin
  603.       keys := '0123456789';
  604.       if min < 0 then
  605.          keys := keys + '-';
  606.  
  607.       str(data,temp);      { convert data to string }
  608.  
  609.       repeat
  610.          raw_editor( func, x, y, prompt, temp, width, term, false, keys);
  611.  
  612.          if func <> edit then
  613.             exit;
  614.  
  615.       (* record location of last edited data *)
  616.          lastData := @data;
  617.          lastSize := sizeof(data);
  618.  
  619.          val( temp, new_data, code );  { convert string to int }
  620.  
  621.          if (new_data < min) or (new_data > max) then
  622.             code := 1;                 { out of range }
  623.  
  624.          if code = 0 then
  625.             data := new_data
  626.          else
  627.          begin
  628.             beep;           { code is 0 if data is valid }
  629.             str(data,temp);
  630.             if (term >= F1) and (term <= F10) then
  631.                exit;  { allow invalid data without change on F-keys}
  632.          end;
  633.  
  634.       until ( code = 0 );
  635.    end;
  636.  
  637.  
  638.    (* -------------------------------------------------- *)
  639.    procedure edit_integer( func:     edit_functions;
  640.                            x,y:      integer;
  641.                            prompt:   string;
  642.                            var data: integer;
  643.                            width:    integer;
  644.                            min,max:  integer;
  645.                            var term: char );
  646.    var
  647.       int:     longint;
  648.    begin
  649.       int := data;
  650.       edit_longint(func,x,y,prompt,int,width,min,max,term);
  651.       data := int;
  652.  
  653.       (* record location of last edited data *)
  654.       if func=edit then
  655.       begin
  656.          lastData := @data;
  657.          lastSize := sizeof(data);
  658.       end;
  659.    end;
  660.  
  661.  
  662.    (* -------------------------------------------------- *)
  663.    procedure edit_byte   ( func:     edit_functions;
  664.                            x,y:      integer;
  665.                            prompt:   string;
  666.                            var data: byte;
  667.                            width:    integer;
  668.                            min,max:  byte;
  669.                            var term: char );
  670.    var
  671.       int:        longint;
  672.    begin
  673.       int := data;
  674.       edit_longint(func,x,y,prompt,int,width,min,max,term);
  675.       data := int;
  676.  
  677.       (* record location of last edited data *)
  678.       if func=edit then
  679.       begin
  680.          lastData := @data;
  681.          lastSize := sizeof(data);
  682.       end;
  683.    end;
  684.  
  685.  
  686.    (* -------------------------------------------------- *)
  687.    procedure edit_word( func:     edit_functions;
  688.                         x,y:      integer;
  689.                         prompt:   string;
  690.                         var data: word;
  691.                         width:    integer;
  692.                         min,max:  word;
  693.                         var term: char );
  694.    var
  695.       int:     longint;
  696.    begin
  697.       int := data;
  698.       edit_longint(func,x,y,prompt,int,width,min,max,term);
  699.       data := int;
  700.  
  701.       (* record location of last edited data *)
  702.       if func=edit then
  703.       begin
  704.          lastData := @data;
  705.          lastSize := sizeof(data);
  706.       end;
  707.    end;
  708.  
  709.  
  710.    (* -------------------------------------------------- *)
  711.    procedure edit_real   ( func:     edit_functions;
  712.                            x,y:      integer;
  713.                            prompt:   string;
  714.                            var data: real;
  715.                            width:    integer;
  716.                            deci:     integer;
  717.                            var term: char );
  718.    var
  719.       temp:       string;
  720.       code:       integer;
  721.       new_data:   real;
  722.  
  723.    begin
  724.       str(data:0:deci,temp);      { convert data from float to string }
  725.  
  726.       repeat
  727.          raw_editor( func, x, y, prompt, temp, width, term, true, '0123456789.E-');
  728.  
  729.          if func <> edit then
  730.             exit;
  731.  
  732.       (* record location of last edited data *)
  733.          lastData := @data;
  734.          lastSize := sizeof(data);
  735.  
  736.          val( temp, new_data, code );  { convert string to int }
  737.  
  738.          if code = 0 then
  739.             data := new_data
  740.          else
  741.          begin
  742.             beep;           { code is 0 if data is valid }
  743.             str(data,temp);
  744.             if (term >= F1) and (term <= F10) then
  745.                exit;  { allow invalid data without change on F-keys}
  746.          end;
  747.  
  748.       until ( code = 0 );
  749.    end;
  750.  
  751.  
  752.    (* -------------------------------------------------- *)
  753.    procedure edit_yesno( func:      edit_functions;
  754.                          x,y:       integer;
  755.                          prompt:    string;
  756.                          var data:  boolean;
  757.                          var term:  char );
  758.    var
  759.       yesno:   string;
  760.  
  761.    begin
  762.       if ord(data)=2 then
  763.          yesno := 'A'
  764.       else
  765.       if data then
  766.          yesno := 'Y'
  767.       else
  768.          yesno := 'N';
  769.  
  770.       raw_editor( func, x, y, prompt, yesno, 1, term, true, 'YNA');
  771.  
  772.       if yesno[1] = 'A' then
  773.          byte(data) := 2
  774.       else
  775.          data := yesno[1] = 'Y';
  776.  
  777.       (* record location of last edited data *)
  778.       if func = edit then
  779.       begin
  780.          lastData := @data;
  781.          lastSize := sizeof(data);
  782.       end;
  783.    end;
  784.  
  785.  
  786.    (* -------------------------------------------------- *)
  787.    procedure edit_funkey( func:      edit_functions;
  788.                           x,y:       integer;
  789.                           prompt:    string;
  790.                           key:       char;
  791.                           var term:  char );
  792.    begin
  793.       if func = edit then
  794.       begin
  795.          gotoxy( x, y );
  796.          textbackground(input_attr shr 4);
  797.          textcolor(input_attr and 15);
  798.          disp( prompt );
  799.  
  800.          term := get_key;
  801.          if term = ENTERKEY then
  802.             term := key;
  803.       end;
  804.  
  805.       gotoxy( x, y );
  806.       textbackground(prompt_attr shr 4);
  807.       textcolor(prompt_attr and 15);
  808.       disp( prompt );
  809.    end;
  810.  
  811.  
  812.    (* -------------------------------------------------- *)
  813.    procedure select_next_entry( func:    edit_functions;
  814.                                 var en:  integer;
  815.                                 maxen:   integer;
  816.                                 var key: char);
  817.    begin
  818.       if func = display then
  819.          exit;
  820.  
  821.       case key of
  822.          TAB, ENTERKEY, DOWN:
  823.             begin
  824.                key := DOWN;
  825.                if en < maxen then
  826.                   inc(en)
  827.                else
  828.                   en := 1;
  829.             end;
  830.  
  831.          UP:   if en > 1 then
  832.                   dec(en)
  833.                else
  834.                   en := maxen;
  835.  
  836.          CTRL_HOME:
  837.                begin
  838.                   en := 1;
  839.                   key := DOWN;
  840.                end;
  841.  
  842.          CTRL_END:
  843.                begin
  844.                   en := maxen;
  845.                   key := UP;
  846.                end;
  847.       end;
  848.    end;
  849.  
  850. (* -------------------------------------------------- *)
  851.    procedure clear_screen;
  852.    begin
  853.       clrscr;
  854.       py := -1;
  855.       px := -1;
  856.    end;
  857.  
  858. (* -------------------------------------------------- *)
  859.    procedure vscroll_bar(current, min, max: word;
  860.                          x,y1,y2: byte);
  861.    var
  862.       y: integer;
  863.       i: integer;
  864.    begin
  865.       y := ((longint(current-min) * longint(y2-y1)) div longint(max-min)) + y1;
  866.       if y = py then
  867.          exit;
  868.  
  869.       py := y;
  870.       for i := y1 to y2 do
  871.       begin
  872.          gotoxy(x,i);
  873.          if i = y then
  874.             disp('█')
  875.          else
  876.             disp('░');
  877.       end;
  878.    end;
  879.  
  880. (* -------------------------------------------------- *)
  881.    procedure hscroll_bar(current, min, max: word;
  882.                          y,x1,x2: byte);
  883.    var
  884.       x: integer;
  885.       i: integer;
  886.    begin
  887.       x := ((longint(current-min) * longint(x2-x1)) div longint(max-min)) + x1;
  888.       if x = px then
  889.          exit;
  890.  
  891.       px := x;
  892.       for i := x1 to x2 do
  893.       begin
  894.          gotoxy(i,y);
  895.          if i = x then
  896.             disp('█')
  897.          else
  898.             disp('░');
  899.       end;
  900.    end;
  901.  
  902.    (* ------------------------------------------------------------ *)
  903.    procedure input(var line:  string;
  904.                    maxlen:    integer);
  905.    var
  906.       c:     char;
  907.  
  908.    begin
  909.       line := '';
  910.  
  911.       repeat
  912.          c := get_key;
  913.  
  914.          case c of
  915.             ' '..#126:
  916.                if length(line) < maxlen then
  917.                begin
  918.                   inc(line[0]);
  919.                   line[length(line)] := c;
  920.                   disp(c);
  921.                end
  922.                else
  923.                   beep;
  924.  
  925.             ^H,#127:
  926.                if length(line) > 0 then
  927.                begin
  928.                   dec(line[0]);
  929.                   disp(^H' '^H);
  930.                end;
  931.  
  932.             ^M:   ;
  933.  
  934.             ^C:   begin
  935.                       displn('^C');
  936.                       halt(99);
  937.                   end;
  938.          end;
  939.  
  940.       until (c = ^M);
  941.    end;
  942.  
  943.  
  944. (* -------------------------------------------------- *)
  945.    procedure opentrace(name: string);
  946.    begin
  947.       assign(tracefd,name);
  948.       rewrite(tracefd);
  949.       traceopen := true;
  950.    end;
  951.  
  952.    procedure closetrace;
  953.    begin
  954.       close(tracefd);
  955.       traceopen := false;
  956.    end;
  957.  
  958.  
  959.  
  960. (* -------------------------------------------------- *)
  961.    procedure save_display(var disp: display_image_rec);
  962.    begin
  963.       disp.crt := disp_mem^;
  964.       disp.mode := lastmode;
  965.       disp.attr := textattr;
  966.       disp.wmin := windmin;
  967.       disp.wmax := windmax;
  968.       disp.x := wherex;
  969.       disp.y := wherey;
  970.    end;
  971.  
  972.    procedure restore_display(var disp: display_image_rec);
  973.    begin
  974.       disp_mem^ := disp.crt;
  975.       lastmode := disp.mode;
  976.       textattr := disp.attr;
  977.       windmin := disp.wmin;
  978.       windmax := disp.wmax;
  979.       gotoxy(disp.x,disp.y);
  980.    end;
  981.  
  982.  
  983.    procedure shadow_display;
  984.    var
  985.       i: integer;
  986.    begin
  987.       for i := 1 to 2000 do
  988.          with disp_mem^[i] do
  989.             attr := attr and 7;
  990.    end;
  991.  
  992.  
  993. (* -------------------------------------------------- *)
  994. var
  995.    Vmode: byte absolute $0040:$0049;   {Current video mode}
  996. begin
  997.    if (Vmode = 1{MDA}) or (Vmode = 7{VgaMono}) then
  998.    begin
  999.       disp_mem := ptr($B000,0);
  1000.       prompt_attr := (BLACK*16)    + WHITE;
  1001.       input_attr  := (WHITE*16)    + BLACK;
  1002.       data_attr   := (BLACK*16)    + WHITE;
  1003.    end
  1004.    else
  1005.       disp_mem := ptr($B800,0);
  1006.  
  1007.    assignCrt(output);
  1008.    rewrite(output);
  1009.    directvideo := pos('/BIO',GetEnv('PCB')) = 0;
  1010. end.
  1011.  
  1012.  
  1013.